(***********************************************************************)
(*                                                                     *)
(*  Programowanie Funkcyjne                                            *)
(*  Wydział MiMUW                                                      *)
(*                                                                     *)
(*  Marcin Walas                                                       *)
(*  262460                                                             *)
(*                                                                     *)
(***********************************************************************)
(*

*)

(* external *)
open OImages;;
open Printf;;

(* internal *)
open Gameabstract;;
open Common;;
open Ai;;


module BreaktroughInternalImpl =
    struct
        type field_type = Empty | White | Red 
        type board_type = Board of field_type list list

        type piece_type = field_type*int*int*bool
        type pieces_type = (piece_type list) * (piece_type list)

        type human_state_type = {
            mutable first_checked: bool;
            mutable first_x:int;
            mutable first_y:int;
        }

        (* cały stan gry tutaj musi siedzieć *)
        type state_type = { pieces:pieces_type; human_state:human_state_type }

        type move_type = piece_type*(int*int)

        (* WARNING the same as in checkers! *)
        let get_at (state:state_type) (x:int) (y:int) = 
            let a, b = state.pieces in
            let pom acc b =
                let t, xl, yl,_ = b in
                if xl = x && yl = y then
                    t::acc
                else
                    acc
            in
            let result = (List.fold_left pom [] a)@(List.fold_left pom [] b) in
            (
            match result with
                result::_ -> result | 
                [] -> Empty
            )
            ;;

        (* WARNING : similar to that in checkers module *)
        let set_checked (state:state_type) (x:int) (y:int) (checked:bool) = 
            let a, b = state.pieces in
            let pom acc b =
                let t,xl,yl,_ = b in
                if (x = xl) && (y = yl) then
                    (t,xl,yl,checked)::acc
                else
                    b::acc
            in
            { pieces = ((List.fold_left pom [] a), (List.fold_left pom [] b)); human_state = state.human_state; };;

 
        let reds (typ:field_type) = 
            if typ = Empty then
                failwith "Empty have no color"
            else
                if typ = Red then true else false;;

        let empty_board = Board [[]];;
        let start_board = empty_board;;



        let get_rgb_for_type =
            let get_rgb path = (
                let img = OImages.load path [] in
                    OImages.rgb24(img)
                ) in
            let red_rgb = get_rgb "img/red.jpg" in
            let white_rgb = get_rgb "img/white.jpg" in

            let red_checked = get_rgb "img/red_checked.jpg" in
            let white_checked = get_rgb "img/white_checked.jpg" in


            (fun (typ:field_type) (checked:bool)-> 
                if checked then (
                match typ with
                    Red -> red_checked |
                    White -> white_checked |
                    Empty -> failwith "Type have no image associated"

                ) else (
                match typ with
                    Red -> red_rgb |
                    White -> white_rgb |
                    Empty -> failwith "Type have no image associated"

                )
            )


        (* WARNING : similar to the checkers' one *)
        let put_piece (state:state_type) (piece:piece_type) = 

            let typ, x, y, t = piece in 

            if (get_at state x y) != Empty then
                failwith "You cannot put piece on another piece"
            else 
                let r, w = state.pieces in 
                    if reds typ then
                        { pieces = (piece::r,w); human_state = state.human_state }
                    else
                        { pieces = (r, piece::w); human_state = state.human_state }
           ;;


        let remove_piece (state:state_type) (x:int) (y:int) =
            let r, w = state.pieces in
            let pom acc b = let (f, lx, ly, t) = b in if lx = x && ly = y then (acc) else b::acc in
            let nr = List.fold_left pom [] r in
            let nw = List.fold_left pom [] w in

            { pieces = (nr, nw); human_state = state.human_state; };;

        let make_move (state:state_type) (move:move_type) =
            (*
             Zakładam tutaj ślepo, że ruch jest poprawny.
            *)
            let (figure, x, y, b), (ex, ey) = move in

            let dx = ex-x in
            let dy = ey-y in 
            let state = 
                if (abs dx >= 2) then
                    (remove_piece state ((signum dx)*((abs dx)-1)+x) ((signum dy)*((abs dy)-1)+y))
                else
                    state
            in
            (put_piece (remove_piece state x y) 
                (figure, ex, ey, b)
            )
            ;;


        let check_move (state:state_type) (move:move_type) =
            let (figure, x, y, b), (ex, ey) = move in

            let dx = ex-x in
            let dy = ey-y in 
            

            (* poruszamy sie jak zwykła figura *)
            
            ((get_at state ex ey) = Empty) &&
            (
                     ((dx = 0) &&
                    ((dy = -1 && (not (reds figure))) || (dy = 1 && (reds figure)) )
                    )
                    ||
                    ((dx = -2 || dx = 2) &&
                    ((dy = -2 && (not (reds figure))) || (dy = 2 && (reds figure)) ) &&
                    ( get_at state (x+dx/2) (y+dy/2) != Empty ) &&
                    ( reds (get_at state (x+dx/2) (y+dy/2)) != reds figure)
                    )
                )
            ;;


        let create_piece_row (typ:field_type) (row:int) = 
            let rec pom acc i = 
                let acc = 
                     ((typ, i, row, false)::acc) in
                if i = 0 then
                    acc
                else
                    pom acc (i-1)
            in
            pom [] 7;;


        let start_pieces = ( (create_piece_row Red 0)@(create_piece_row Red 1) , (create_piece_row White 6)@(create_piece_row White 7) );;

        let start_state () = {
            pieces = start_pieces;
            human_state = 
                {
                    first_checked = false;
                    first_x = 0; first_y = 0;
                }
        };;

        let iter_through_pieces (state:state_type) (funct:(int -> int -> OImages.rgb24 -> unit)) =

            let red, white = state.pieces in
            let pom acc b = 
            (
                let piece, x, y, checked  = b in
                   (funct x y (get_rgb_for_type piece checked ) )::acc
            )   
            in
                (
                let _ = List.fold_left pom [] red in
                let _ = List.fold_left pom [] white in
                ()
                );;


        let click_handler (state:state_type) (red:bool) (x:int) (y:int) =
            eprintf "checkers_impl : click_handler called with %d %d \n" x y;
            flush stderr;
            (* tutaj nastepuje obsluga klikniecia przez uzytkownika na jakiekolwiek pole w grze *)

            if state.human_state.first_checked then (
                state.human_state.first_checked <- false;

                let o_x = state.human_state.first_x in let o_y = state.human_state.first_y in 
                let state = set_checked state o_x o_y false in
                let move =  (((get_at state o_x o_y), o_x, o_y, false),(x,y)) in
                if (check_move state move) then
                    (true, make_move state move)
                else
                    (false, state)
            )
            else
            (
                let piece = if red then Red else White in
                if (get_at state x y) = piece  then
                (
                    state.human_state.first_checked <- true;
                    state.human_state.first_x <- x;
                    state.human_state.first_y <- y;

                    false, (set_checked state x y true)
                )
                else
                (false, state)
            );;

        let empty_move = (Empty, -1, -1, false), (-2,-2);;

        let wrap_state board = { pieces = board; human_state = (start_state ()).human_state;};;
        let get_pieces (state:state_type) = state.pieces;;

    end;;


module BreaktroughInternal = (BreaktroughInternalImpl : Gameabstract.GAME_INSTANCE);;

     
module BreaktroughGame = GameAbstract(BreaktroughInternalImpl);;

module type BREAKTROUGH_EXTENDED = 
    sig
(*        include GAME_INSTANCE *)
        type field_type(* = CheckersInternal.field_type*)

        type move_type(* = CheckersInternalImpl.move_type*)
        type piece_type(* = CheckersInternalImpl.piece_type*)
        type pieces_type(* = CheckersInternalImpl.pieces_type*)

        type human_state_type
        type state_type (*= CheckersGame.state_type(* = CheckersInternalImpl.state_type *) *)

        val empty_move : move_type

        val wrap_state : pieces_type -> state_type
        val get_pieces : state_type -> pieces_type
   end;;



module BreaktroughExtended = (BreaktroughInternalImpl : BREAKTROUGH_EXTENDED
    with type human_state_type = BreaktroughInternalImpl.human_state_type
    with type field_type = BreaktroughInternalImpl.field_type

    with type move_type = BreaktroughInternalImpl.move_type
    with type pieces_type = BreaktroughInternalImpl.pieces_type

    with type state_type = BreaktroughInternalImpl.state_type);;


let rec print_list lista =
match lista with
        
    [] -> ()
    | (_, x, y,_)::t -> eprintf " (%d, %d)" x y; print_list t ;;


module BreaktroughAIInternal (*: AI_INTERNAL*) = 

    struct

        type board_type = BreaktroughInternalImpl.pieces_type;;
        type move_type = BreaktroughInternalImpl.move_type;;

        let get_weight (board:board_type) (red:bool) = 
            (* Na razie bardzo prosta funkcja *)
            let calc_weight r w = (  (  ((float (r)) -. (float (w)) ) *. (if red then 1. else -1.) )+.8. ) /. 32. in
            let r, w = board in
            let result = 
               ( calc_weight (List.length r) (List.length w) )
            in
            result
            ;;

        let wrap_state (board:board_type) = BreaktroughInternalImpl.wrap_state board;;

        let get_moves (board: board_type) (red:bool) = 
            
            let r,w = board in
            let pom acc b =
                let (typ, x, y, t) = b in
                let max_i = 2 in
                let rec move_gen vx vy i =                    
                    if vx < 0 || vy < 0 || vx >= 8 || vy >= 8 || i > max_i then 
                    []
                    else
                    (
                    let move = b, (vx, vy) in
                    if (BreaktroughInternalImpl.check_move (wrap_state board) move) then [move] else []
                    )@(move_gen (vx + signum (vx-x)) (vy + signum (vy-y)) (i+1))
                in
                (move_gen (x+2) (y+2) 1)@(move_gen (x+2) (y-2) 1)@(move_gen (x-2) (y+2) 1)@(move_gen (x-2) (y-2) 1)@(move_gen (x) (y-1) 1)@(move_gen (x) (y+1) 1)@acc
            in
            List.fold_left pom [] (if red then r else w);;

        let make_move (board:board_type) (move:move_type) = BreaktroughInternalImpl.get_pieces (BreaktroughInternalImpl.make_move (wrap_state board) move);;

        let empty_move = BreaktroughInternalImpl.empty_move;;

    end;;


module BreaktroughAI = AIAbstract(BreaktroughAIInternal);;








